;; 第三章：模块化/对象和状态
;; 练习3.1
(define (make-accumulater init)
  (lambda (x)
    (set! init (+ init x))
    init))
(define A (make-accumulater 5))
(A 10)
(A 10)
;; 练习3.2
(define (make-monitored f)
  (let ((count 0))
    (lambda (x) 
      (cond ((equal? x 'how-many-calls?) count)
	    (else (set! count (+ 1 count)) (f x))))))
(define s (make-monitored sqrt))
(s 100)
(s 'how-many-calls?)
;; 练习3.3
(define (make-account balance password)
  (define (withdraw amount) (set! balance (- balance amount)) balance)
  (define (deposit amount) (set! balance (+ balance amount)))
  (lambda (passwd operate)
    (if (not (equal? passwd password))
	(lambda (x) "Incorrect password")
	(cond ((equal? 'withdraw operate) withdraw)
	      ((equal? 'deposit operate) deposit)))))
(define acc (make-account 100 'secret-password))
((acc 'secret-password 'withdraw) 40)
((acc 'some-other-password 'deposit) 50)
;; 练习3.4(略）
;; 练习3.5
(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))
;; (random-in-range 1 10.1)
(define (estimate-integral P x1 x2 y1 y2 trails)
  (define (iter trails-remain trails-passed)
    (if (zero? trails-remain)
	trails-passed
	(let ((x (random-in-range x1 x2))
	      (y (random-in-range y1 y2)))
	  (iter (- trails-remain 1)
		(if (P x y)
		    (+ 1 trails-passed)
		    trails-passed)))))
  (/ (iter trails 0) trails))
(* 36.0 (estimate-integral (lambda (x y)
		     (< 9 (+ (square (- 5 x)) (square (- 7 y)))))
		   2.0 8.0 4.0 10.0 10000))
(* 1.0 (estimate-integral (lambda (x y) (< x y))
			  0 1.0 0 1.0 100000))
;; (define (estimate-pi trails)
;;   (sqrt (/ 6 (monte-carlo trails cesaro-test))))
;; (define (cesaro-test) (= (gcd (rand) (rand)) 1))
(define (estimate-pi trails)
  (* 4.0 (estimate-integral (lambda (x y) (> 1 (+ (square x) (square y))))
			    -1.0 1.0 -1.0 1.0 trails)))
(estimate-pi 100000)

(define x '((1 2) 3 4))
(define y '(5 6))
(set-car! x y)
(set-car! y 7)
x
y

(define x '(1))
(set-cdr! x 2)
(cdr '(1 2))
(cdr (cons 1 2))
(define x '(1 2))
x
(list? x)
(set-cdr! (cdr x) '(2))
x
(list? x)

;; 练习3.12
(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))
(define x (list 'a 'b))
(define y (list 'c 'd))
(define z (append x y))
z
(cdr x)
(define w (append! x y))
(cdr x)
;; 练习3.13
(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)
(define z (make-cycle (list 'a 'b 'c)))
(last-pair z)
;; 练习3.17
(define (count-pairs x)
  (let ((history '()))
    (define (iter x history)
      (if (or (not (pair? x)) (memq x history)) 
	  0
	  (begin
	    (set! history (cons x history))
	      (+ 1 
		 (iter (car x) history)
		 (iter (cdr x) history)))))
    (iter x '())))
(count-pairs '(1 2 3))
(count-pairs z)
;; 练习3.19
;; x1步进为1，x2步进为2，若x2追上x1，则有圈
(define (has-cycle? seq)
    (define (iter x1 x2)
      (cond ((eq? x1 x2) #t)
	    ((or (null? x1) (null? x2) (null? (cdr x2))) #f)
	    (else (iter (cdr x1) (cddr x2)))))
    (iter seq (cdr seq)))
(has-cycle? z)
(has-cycle? x)
;; (display 1)
;; 3.3.2 队列的表示
(define (front-ptr quene) (car quene))
(define (rear-ptr quene) (cdr quene))
(define (set-front-ptr! quene item) (set-car! quene item))
(define (set-rear-ptr! quene item) (set-cdr! quene item))
(define (empty-quene? quene) (null? (front-ptr quene)))
(define (make-quene) (cons '() '()))
(define (front-quene quene)
  (if (empty-quene? quene)
      (error "FRONT called with an empty quene" quene)
      (car (front-ptr quene))))
(define (insert-quene! quene item)
  (let ((new-pair (cons item '())))
    (cond ((empty-quene? quene)
	   (set-front-ptr! quene new-pair)
	   (set-rear-ptr! quene new-pair)
	   quene)
	  (else
	   (set-cdr! (rear-ptr quene) new-pair)
	   (set-rear-ptr! quene new-pair)
	   quene))))
(define (delete-quene! quene)
  (cond ((empty-quene? quene)
	 (error "DELETE! called with an empty quene" quene))
	(else
	 (set-front-ptr! quene (cdr (front-ptr quene))))))
;; 练习3.21
(define q1 (make-quene))
(insert-quene! q1 'a)
(insert-quene! q1 'b)
(delete-quene! q1)
(delete-quene! q1)
(define (print-quene quene)
  (display (front-ptr quene)))
(print-quene q1)
;; 练习3.22
(define (make-quene)
  (let ((front-ptr '())
	(rear-ptr '()))
    (define (empty-quene?) (null? front-ptr))
    (define (delete-quene!)
      (cond ((empty-quene?)
	     (error "DELETE! called with an empty quene"))
	    (else
	     (set! front-ptr (cdr front-ptr)) ;; set! 返回修改之前的值
	     front-ptr)))
    (define (insert-quene! item)
      (let ((new-pair (cons item '())))
	(cond ((empty-quene?)
	       (set! front-ptr new-pair)
	       (set! rear-ptr new-pair)
	       front-ptr)
	      (else
	       (set-cdr! rear-ptr new-pair)
	       (set! rear-ptr new-pair)
	       front-ptr))))
    (define (front-quene)
      (if (empty-quene?)
	  (error "FRONT called with an empty quene")
	  (car front-ptr)))
    (define (dispatch m)
      (cond ((eq? m 'front-quene) front-quene)
	    ((eq? m 'delete-quene!) delete-quene!)
	    ((eq? m 'insert-quene!) insert-quene!)
	    ((eq? m 'empty-quene?) empty-quene?)))
    dispatch))
(define q2 (make-quene))
((q2 'insert-quene!) 'a)
((q2 'insert-quene!) 'b)
((q2 'delete-quene!))
((q2 'delete-quene!))

;; exercise 3.74
(define (sign-change-detector x y)
  (define (sign x)
    (cond ((< x 0) -1)
	  ((> x 0) 1)
	  (else 0)))
  (let ((sx (sign x)) (sy (sign y)))
    (cond ((or (= sx sy) (= 0 sx) (= 0 sy)) 0)
	  ((< sx sy) 1)
	  ((> sx sy) -1))))
;; exercise 3.75
;; 添加参数last-avpt
(define (make-zero-crossings input-stream last-value last-avpt)
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-change-detector avpt last-avpt)
                 (make-zero-crossings (stream-cdr input-stream)
				      (stream-car input-stream)
				      avpt))))
;; exercise 3.76
(define (smooth s1)
  (stream-map (lambda (x y) (/ (+ x y) 2))
	      s1
	      (stream-cdr s1)))
(define (smooth s)
  (if (or (stream-null? s) (stream-null? (stream-cdr s)))
      the-empty-stream
      (let ((x (stream-car s)) (y (stream-car (stream-cdr s))))
	(cons-stream (/ (+ x y) 2)
		     (smooth (stream-cdr s))))))
(define (make-zero-crossing input-stream init-value)
  (define (iter stream)
    (cons-stream (sign-change-detector (stream-car stream)
				       (stream-car (stream-cdr stream)))
		 (iter (stream-cdr stream))))
  (iter (smooth (cons-stream init-value input-stream))))
(define (test-stream) (cons-stream (random-in-range -1.0 1.0) (test-stream)))
;;(display-stream (test-stream))
(load "../base.scm")
(define (stream-for-n proc s n)
  (map (lambda (x) (stream-ref s x))
       (enumerate-interval 0 (- n 1))))

;; (let ((zc (make-zero-crossing (test-stream) 0)))
;;   (stream-for-n display-line zc 100))


;; exercise 3.77
;; fixme: ;The object (1.001 . #[promise 30]) is not applicable.
;; fixed: let 左边多了一个括号，导致函数调用 (1.001 . #[promise 30])
(define (integral delayed-integrand initial-value dt)
  (cons-stream initial-value
               (if (stream-null? (force delayed-integrand))
                   the-empty-stream
		   (let ((integrand (force delayed-integrand)))
		      (integral (delay (stream-cdr integrand))
				(+ (* dt (stream-car integrand))
				   initial-value)
				dt)))))

;; exercise 3.78
;; exercise 3.79
(define (stream-map f . v)
  (if (stream-null? (car v))
      the-empty-stream
      (cons-stream (apply f (map stream-car v))
		   (stream-map f (map stream-cdr v)))))
;; (stream-for-n (lambda(x) (newline)(display x))
;; 	      (stream-map f (stream-enumerate-interval 1 100)
;; 			   (stream-enumerate-interval 1 100))
;; 	      100)
(define (solve-2nd f y0 dy0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay dyy) dy0 dt))
  (define dyy (stream-map f y dy))
  y)
;; (define dt 0.001)
;; (define dy0 1.0)
;; (define y0 1.0)
;; (define f (lambda (x y) (+ x y)))


;; (stream-ref y 30)
;; (force (cdr dyy))
;; (stream-ref dy 2)
;; (stream-ref dyy 1)

;; (stream-ref y 0)
;; (stream-ref dy 0)
;; (stream-ref dyy 0)
;; (stream-ref (solve-2nd (lambda (x y) (+ x y))
;; 		       1 1 0.001) 1000)